Setup

Packages

# Packages
require(ggplot2)
require(plotly)
require(geojsonio)
require(sp)
require(sf)
require(rvest)
require(RSelenium)
require(htmltools)
require(ggmap)

Data

Data Retrival

# Download file for state info

url = "https://opendata.arcgis.com/datasets/5f45e1ece6e14ef5866974a7b57d3b95_1.geojson"

file = "NJ_counties.geojson"

download.file(url,file)

rm(url)
#get page source from website

gc()
driver <- rsDriver(browser = c("firefox"), port = 44454L)
remote_driver <- driver[["client"]] 
remote_driver$navigate("https://www.childrens-specialized.org/locations-directory/?")

page <- remote_driver$getPageSource()

rm(driver,remote_driver)
# Retrieve information from page

Xpathgen1 = "/html/body/div[1]/div/div/div[2]/div/div[2]/div["

Xpathgen2 = "]/div/div[2]/article"

Hosinfo <- data.frame() # Create empty data frame

for (i in 1:15){ # For each hospital on website 
  XPath <- paste(Xpathgen1,i,Xpathgen2,sep = "") 
  Node <- page[[1]] %>% 
    read_html() %>%
    html_nodes(xpath = XPath)
  name <-
    Node[[1]] %>%
    html_node("h2") %>%
    html_text()
  address <-
    Node[[1]] %>%
    html_node("h3") %>%
    html_text() %>%
    gsub(pattern = "\n *",replacement = " ", x = .)
  for (i in 1:7){
  XPathday <- paste(XPath,"/div[",i,"]",sep = "")
  day <- page[[1]] %>% 
    read_html() %>%
    html_nodes(xpath = XPathday) %>%
    html_attr("class") %>%
    grep("-Hours",x = .,value = TRUE) %>%
    gsub("-Hours","",x = .)
  times <-
    page[[1]] %>% 
    read_html() %>%
    html_nodes(xpath = XPathday) %>%
    html_node("h3") %>%
    html_text()
  assign(day,times)
  rm(day)
  }
  row = data.frame(name,address,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday)
  Hosinfo <-  rbind(Hosinfo,row)
}

rm(row,Xpathgen1,Xpathgen2,XPath,XPathday,i,name,address,Monday,Tuesday,
   Wednesday,Thursday,Friday,Saturday,Sunday,times)

# Write csv file 

write.csv(Hosinfo, "Hospitals.csv")

Data Loading

Hosinfo <- read.csv("Hospitals.csv") # Get Hospital info as a dataframe

file = "NJ_counties.geojson" # Get County info file

NJ_Counties <- # Save as a sf object
  geojson_sf(file)
rm(file)

Data Wrangling

# Clean NJ_Counties 

NJ_Counties_Cleaned <- 
  NJ_Counties %>%
  transmute(
    county = COUNTY,
    CO = CO,
    pop = POP2010,
    popdensity = POPDEN2010,
    Shape_Length = Shape_Length,
    Shape_Area = Shape_Area,
    GNIS = GNIS
  )
# Get Hospital location data

pattern <- "([0-1]*[0-9]:[0-5][0-9] *[AaPp][Mm][-to ]+[0-1]*[0-9]:[0-5][0-9] *[AaPp][Mm])" # Pattern to extract first time range

Hosloc <- 
  Hosinfo %>%
  select(name,address) %>%
  mutate_geocode(address) # Requires google API key

rm(pattern)

write.csv(Hosloc,"Hospitalsloc.csv")

Graphs

# Map of NJ 

NJ <-
  NJ_Counties_Cleaned %>%
  ggplot() +
  geom_sf() +
  theme(legend.position = "None") +
  theme(axis.ticks = element_blank(),
        axis.text = element_blank(),
        title = element_text(size = 9)) +
  labs(y = "",
       x = "",
       title = "Map of NJ divided by county")

ggplotly(NJ)

NJ

plot(NJ_Counties_Cleaned)

# Population heat maps of NJ using 2010 population data

NJ <-
  NJ_Counties_Cleaned %>%
  ggplot() +
  scale_fill_gradientn(colours=c("white", "steelblue")) +
  geom_sf(aes(fill = pop)) +
  theme(legend.position = "None") +
  theme(axis.ticks = element_blank(),
        axis.text = element_blank(),
        title = element_text(size = 9)) +
  labs(y = "",
       x = "",
       title = "2010 Population Heatmap")


ggplotly(NJ)

NJ

plot(NJ_Counties_Cleaned["pop"])


# Location of Hospitals in NJ on heatmap

Hosloc <- read.csv("Hospitalsloc.csv")

# Only need out patient centers 

Hosloc <-
  Hosloc %>%
  filter(grepl("Outpatient", name))


NJ <-
  NJ_Counties_Cleaned %>%
  ggplot() +
  scale_fill_gradientn(colours=c("white", "steelblue")) +
  geom_sf(aes(fill = pop)) +
  geom_point(data = Hosloc,aes(x = lon,y = lat,shape = "square", label = name,color = "orange")) +
  theme(legend.position = "None") +
  theme(axis.ticks = element_blank(),
        axis.text = element_blank(),
        title = element_text(size = 9, family = "serif")) +
  labs(y = "",
       x = "",
       title = "2010 Population Heatmap\nwith CSH Outpatient Center")
ggplotly(NJ,tooltip = "name")

NJ

NJ %>%
ggsave(file="PopheatmapNJ.png", plot = ., width=3, height=4, dpi=300)

LS0tDQp0aXRsZTogIkdlb2pzb24gVGVzdGluZyINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNCiMjIyBTZXR1cA0KYGBge3Igc2V0dXAsIGluY2x1ZGU9RkFMU0V9DQprbml0cjo6b3B0c19jaHVuayRzZXQod2FybmluZyA9IEZBTFNFLCBtZXNzYWdlID0gRkFMU0UpDQpgYGANCiMjIyMgUGFja2FnZXMNCg0KYGBge3J9DQojIFBhY2thZ2VzDQpyZXF1aXJlKGdncGxvdDIpDQpyZXF1aXJlKHBsb3RseSkNCnJlcXVpcmUoZ2VvanNvbmlvKQ0KcmVxdWlyZShzcCkNCnJlcXVpcmUoc2YpDQpyZXF1aXJlKHJ2ZXN0KQ0KcmVxdWlyZShSU2VsZW5pdW0pDQpyZXF1aXJlKGh0bWx0b29scykNCnJlcXVpcmUoZ2dtYXApDQpgYGANCg0KIyMjIERhdGENCg0KIyMjIyBEYXRhIFJldHJpdmFsDQoNCmBgYHtyfQ0KIyBEb3dubG9hZCBmaWxlIGZvciBzdGF0ZSBpbmZvDQoNCnVybCA9ICJodHRwczovL29wZW5kYXRhLmFyY2dpcy5jb20vZGF0YXNldHMvNWY0NWUxZWNlNmUxNGVmNTg2Njk3NGE3YjU3ZDNiOTVfMS5nZW9qc29uIg0KDQpmaWxlID0gIk5KX2NvdW50aWVzLmdlb2pzb24iDQoNCmRvd25sb2FkLmZpbGUodXJsLGZpbGUpDQoNCnJtKHVybCkNCmBgYA0KDQpgYGB7cn0NCiNnZXQgcGFnZSBzb3VyY2UgZnJvbSB3ZWJzaXRlDQoNCmdjKCkNCmRyaXZlciA8LSByc0RyaXZlcihicm93c2VyID0gYygiZmlyZWZveCIpLCBwb3J0ID0gNDQ0NTRMKQ0KcmVtb3RlX2RyaXZlciA8LSBkcml2ZXJbWyJjbGllbnQiXV0gDQpyZW1vdGVfZHJpdmVyJG5hdmlnYXRlKCJodHRwczovL3d3dy5jaGlsZHJlbnMtc3BlY2lhbGl6ZWQub3JnL2xvY2F0aW9ucy1kaXJlY3RvcnkvPyIpDQoNCnBhZ2UgPC0gcmVtb3RlX2RyaXZlciRnZXRQYWdlU291cmNlKCkNCg0Kcm0oZHJpdmVyLHJlbW90ZV9kcml2ZXIpDQpgYGANCg0KYGBge3J9DQojIFJldHJpZXZlIGluZm9ybWF0aW9uIGZyb20gcGFnZQ0KDQpYcGF0aGdlbjEgPSAiL2h0bWwvYm9keS9kaXZbMV0vZGl2L2Rpdi9kaXZbMl0vZGl2L2RpdlsyXS9kaXZbIg0KDQpYcGF0aGdlbjIgPSAiXS9kaXYvZGl2WzJdL2FydGljbGUiDQoNCkhvc2luZm8gPC0gZGF0YS5mcmFtZSgpICMgQ3JlYXRlIGVtcHR5IGRhdGEgZnJhbWUNCg0KZm9yIChpIGluIDE6MTUpeyAjIEZvciBlYWNoIGhvc3BpdGFsIG9uIHdlYnNpdGUgDQogIFhQYXRoIDwtIHBhc3RlKFhwYXRoZ2VuMSxpLFhwYXRoZ2VuMixzZXAgPSAiIikgDQogIE5vZGUgPC0gcGFnZVtbMV1dICU+JSANCiAgICByZWFkX2h0bWwoKSAlPiUNCiAgICBodG1sX25vZGVzKHhwYXRoID0gWFBhdGgpDQogIG5hbWUgPC0NCiAgICBOb2RlW1sxXV0gJT4lDQogICAgaHRtbF9ub2RlKCJoMiIpICU+JQ0KICAgIGh0bWxfdGV4dCgpDQogIGFkZHJlc3MgPC0NCiAgICBOb2RlW1sxXV0gJT4lDQogICAgaHRtbF9ub2RlKCJoMyIpICU+JQ0KICAgIGh0bWxfdGV4dCgpICU+JQ0KICAgIGdzdWIocGF0dGVybiA9ICJcbiAqIixyZXBsYWNlbWVudCA9ICIgIiwgeCA9IC4pDQogIGZvciAoaSBpbiAxOjcpew0KICBYUGF0aGRheSA8LSBwYXN0ZShYUGF0aCwiL2RpdlsiLGksIl0iLHNlcCA9ICIiKQ0KICBkYXkgPC0gcGFnZVtbMV1dICU+JSANCiAgICByZWFkX2h0bWwoKSAlPiUNCiAgICBodG1sX25vZGVzKHhwYXRoID0gWFBhdGhkYXkpICU+JQ0KICAgIGh0bWxfYXR0cigiY2xhc3MiKSAlPiUNCiAgICBncmVwKCItSG91cnMiLHggPSAuLHZhbHVlID0gVFJVRSkgJT4lDQogICAgZ3N1YigiLUhvdXJzIiwiIix4ID0gLikNCiAgdGltZXMgPC0NCiAgICBwYWdlW1sxXV0gJT4lIA0KICAgIHJlYWRfaHRtbCgpICU+JQ0KICAgIGh0bWxfbm9kZXMoeHBhdGggPSBYUGF0aGRheSkgJT4lDQogICAgaHRtbF9ub2RlKCJoMyIpICU+JQ0KICAgIGh0bWxfdGV4dCgpDQogIGFzc2lnbihkYXksdGltZXMpDQogIHJtKGRheSkNCiAgfQ0KICByb3cgPSBkYXRhLmZyYW1lKG5hbWUsYWRkcmVzcyxNb25kYXksVHVlc2RheSxXZWRuZXNkYXksVGh1cnNkYXksRnJpZGF5LFNhdHVyZGF5LFN1bmRheSkNCiAgSG9zaW5mbyA8LSAgcmJpbmQoSG9zaW5mbyxyb3cpDQp9DQoNCnJtKHJvdyxYcGF0aGdlbjEsWHBhdGhnZW4yLFhQYXRoLFhQYXRoZGF5LGksbmFtZSxhZGRyZXNzLE1vbmRheSxUdWVzZGF5LA0KICAgV2VkbmVzZGF5LFRodXJzZGF5LEZyaWRheSxTYXR1cmRheSxTdW5kYXksdGltZXMpDQoNCiMgV3JpdGUgY3N2IGZpbGUgDQoNCndyaXRlLmNzdihIb3NpbmZvLCAiSG9zcGl0YWxzLmNzdiIpDQpgYGANCg0KIyMjIyBEYXRhIExvYWRpbmcNCg0KYGBge3J9DQpIb3NpbmZvIDwtIHJlYWQuY3N2KCJIb3NwaXRhbHMuY3N2IikgIyBHZXQgSG9zcGl0YWwgaW5mbyBhcyBhIGRhdGFmcmFtZQ0KDQpmaWxlID0gIk5KX2NvdW50aWVzLmdlb2pzb24iICMgR2V0IENvdW50eSBpbmZvIGZpbGUNCg0KTkpfQ291bnRpZXMgPC0gIyBTYXZlIGFzIGEgc2Ygb2JqZWN0DQogIGdlb2pzb25fc2YoZmlsZSkNCnJtKGZpbGUpDQpgYGANCg0KDQoNCiMjIyMgRGF0YSBXcmFuZ2xpbmcNCg0KYGBge3J9DQojIENsZWFuIE5KX0NvdW50aWVzIA0KDQpOSl9Db3VudGllc19DbGVhbmVkIDwtIA0KICBOSl9Db3VudGllcyAlPiUNCiAgdHJhbnNtdXRlKA0KICAgIGNvdW50eSA9IENPVU5UWSwNCiAgICBDTyA9IENPLA0KICAgIHBvcCA9IFBPUDIwMTAsDQogICAgcG9wZGVuc2l0eSA9IFBPUERFTjIwMTAsDQogICAgU2hhcGVfTGVuZ3RoID0gU2hhcGVfTGVuZ3RoLA0KICAgIFNoYXBlX0FyZWEgPSBTaGFwZV9BcmVhLA0KICAgIEdOSVMgPSBHTklTDQogICkNCmBgYA0KDQpgYGB7cn0NCiMgR2V0IEhvc3BpdGFsIGxvY2F0aW9uIGRhdGENCg0KcGF0dGVybiA8LSAiKFswLTFdKlswLTldOlswLTVdWzAtOV0gKltBYVBwXVtNbV1bLXRvIF0rWzAtMV0qWzAtOV06WzAtNV1bMC05XSAqW0FhUHBdW01tXSkiICMgUGF0dGVybiB0byBleHRyYWN0IGZpcnN0IHRpbWUgcmFuZ2UNCg0KSG9zbG9jIDwtIA0KICBIb3NpbmZvICU+JQ0KICBzZWxlY3QobmFtZSxhZGRyZXNzKSAlPiUNCiAgbXV0YXRlX2dlb2NvZGUoYWRkcmVzcykgIyBSZXF1aXJlcyBnb29nbGUgQVBJIGtleQ0KDQpybShwYXR0ZXJuKQ0KDQp3cml0ZS5jc3YoSG9zbG9jLCJIb3NwaXRhbHNsb2MuY3N2IikNCmBgYA0KDQoNCiMjIyBHcmFwaHMgDQoNCmBgYHtyfQ0KIyBNYXAgb2YgTkogDQoNCk5KIDwtDQogIE5KX0NvdW50aWVzX0NsZWFuZWQgJT4lDQogIGdncGxvdCgpICsNCiAgZ2VvbV9zZigpICsNCiAgdGhlbWUobGVnZW5kLnBvc2l0aW9uID0gIk5vbmUiKSArDQogIHRoZW1lKGF4aXMudGlja3MgPSBlbGVtZW50X2JsYW5rKCksDQogICAgICAgIGF4aXMudGV4dCA9IGVsZW1lbnRfYmxhbmsoKSwNCiAgICAgICAgdGl0bGUgPSBlbGVtZW50X3RleHQoc2l6ZSA9IDkpKSArDQogIGxhYnMoeSA9ICIiLA0KICAgICAgIHggPSAiIiwNCiAgICAgICB0aXRsZSA9ICJNYXAgb2YgTkogZGl2aWRlZCBieSBjb3VudHkiKQ0KDQpnZ3Bsb3RseShOSikNCk5KDQpwbG90KE5KX0NvdW50aWVzX0NsZWFuZWQpDQpgYGANCg0KDQoNCmBgYHtyfQ0KIyBQb3B1bGF0aW9uIGhlYXQgbWFwcyBvZiBOSiB1c2luZyAyMDEwIHBvcHVsYXRpb24gZGF0YQ0KDQpOSiA8LQ0KICBOSl9Db3VudGllc19DbGVhbmVkICU+JQ0KICBnZ3Bsb3QoKSArDQogIHNjYWxlX2ZpbGxfZ3JhZGllbnRuKGNvbG91cnM9Yygid2hpdGUiLCAic3RlZWxibHVlIikpICsNCiAgZ2VvbV9zZihhZXMoZmlsbCA9IHBvcCkpICsNCiAgdGhlbWUobGVnZW5kLnBvc2l0aW9uID0gIk5vbmUiKSArDQogIHRoZW1lKGF4aXMudGlja3MgPSBlbGVtZW50X2JsYW5rKCksDQogICAgICAgIGF4aXMudGV4dCA9IGVsZW1lbnRfYmxhbmsoKSwNCiAgICAgICAgdGl0bGUgPSBlbGVtZW50X3RleHQoc2l6ZSA9IDkpKSArDQogIGxhYnMoeSA9ICIiLA0KICAgICAgIHggPSAiIiwNCiAgICAgICB0aXRsZSA9ICIyMDEwIFBvcHVsYXRpb24gSGVhdG1hcCIpDQoNCg0KZ2dwbG90bHkoTkopDQpOSg0KcGxvdChOSl9Db3VudGllc19DbGVhbmVkWyJwb3AiXSkNCmBgYA0KDQoNCmBgYHtyfQ0KDQojIExvY2F0aW9uIG9mIEhvc3BpdGFscyBpbiBOSiBvbiBoZWF0bWFwDQoNCkhvc2xvYyA8LSByZWFkLmNzdigiSG9zcGl0YWxzbG9jLmNzdiIpDQoNCiMgT25seSBuZWVkIG91dCBwYXRpZW50IGNlbnRlcnMgDQoNCkhvc2xvYyA8LQ0KICBIb3Nsb2MgJT4lDQogIGZpbHRlcihncmVwbCgiT3V0cGF0aWVudCIsIG5hbWUpKQ0KDQoNCk5KIDwtDQogIE5KX0NvdW50aWVzX0NsZWFuZWQgJT4lDQogIGdncGxvdCgpICsNCiAgc2NhbGVfZmlsbF9ncmFkaWVudG4oY29sb3Vycz1jKCJ3aGl0ZSIsICJzdGVlbGJsdWUiKSkgKw0KICBnZW9tX3NmKGFlcyhmaWxsID0gcG9wKSkgKw0KICBnZW9tX3BvaW50KGRhdGEgPSBIb3Nsb2MsYWVzKHggPSBsb24seSA9IGxhdCxzaGFwZSA9ICJzcXVhcmUiLCBsYWJlbCA9IG5hbWUsY29sb3IgPSAib3JhbmdlIikpICsNCiAgdGhlbWUobGVnZW5kLnBvc2l0aW9uID0gIk5vbmUiKSArDQogIHRoZW1lKGF4aXMudGlja3MgPSBlbGVtZW50X2JsYW5rKCksDQogICAgICAgIGF4aXMudGV4dCA9IGVsZW1lbnRfYmxhbmsoKSwNCiAgICAgICAgdGl0bGUgPSBlbGVtZW50X3RleHQoc2l6ZSA9IDksIGZhbWlseSA9ICJzZXJpZiIpKSArDQogIGxhYnMoeSA9ICIiLA0KICAgICAgIHggPSAiIiwNCiAgICAgICB0aXRsZSA9ICIyMDEwIFBvcHVsYXRpb24gSGVhdG1hcFxud2l0aCBDU0ggT3V0cGF0aWVudCBDZW50ZXIiKQ0KZ2dwbG90bHkoTkosdG9vbHRpcCA9ICJuYW1lIikNCk5KDQoNCk5KICU+JQ0KZ2dzYXZlKGZpbGU9IlBvcGhlYXRtYXBOSi5wbmciLCBwbG90ID0gLiwgd2lkdGg9MywgaGVpZ2h0PTQsIGRwaT0zMDApDQoNCmBgYA0KDQo=